home *** CD-ROM | disk | FTP | other *** search
/ Meeting Pearls 4 / Meeting Pearls Vol. IV (1996)(GTI - Schatztruhe)[!].iso / Pearls / dev / Oberon / OberonV4 / system / Colors.Mod (.txt) < prev    next >
Oberon Text  |  1996-05-27  |  13KB  |  312 lines
  1. Syntax24.Scn.Fnt
  2. Syntax10.Scn.Fnt
  3. Syntax10i.Scn.Fnt
  4. (* Notify Ralf for maintenance of Non-FPU source *)
  5. MODULE Colors; (** ww 23 Jan 91 / RC 28.10.93**)
  6.   IMPORT Amiga, Display, Texts, TextFrames, Viewers, MenuViewers, Oberon, Input, Files;
  7.   CONST Menu = "System.Close  System.Copy  System.Grow";
  8.     (*Cols = 16;  (* Number of Colors to be represented *)*)
  9.     MaxInt = 255;  (* maximum value for intensity *)
  10.     Left = 2; Middle = 1; Right = 0;  (* mouse buttons *)
  11.     Comp = 3; H = 0; L = 1; S = 2;  R = 0; G = 1; B = 2;  (* Just for clarifying some things later ... *)
  12. (* Colors 1 .. 3 are supposed to represent red green and blue. They are not editable with this tool. *)
  13.   TYPE
  14.     Frame = POINTER TO FrameDesc;
  15.     FrameDesc = RECORD(Display.FrameDesc)
  16.       beg: ARRAY 256 OF INTEGER;
  17.       n: INTEGER
  18.     END;
  19.     Components = ARRAY Comp OF REAL;
  20.     Color = RECORD
  21.       rgb, hls: Components;
  22.       nr: INTEGER
  23.     END;
  24.     EditFrame = POINTER TO EditFrameDesc;
  25.     EditFrameDesc = RECORD(Display.FrameDesc)
  26.       beg: ARRAY Comp + 1 OF INTEGER;
  27.       col: Color;
  28.       rgb: BOOLEAN
  29.     END;
  30.     Msg = RECORD(Display.FrameMsg) END;
  31.   VAR w: Texts.Writer; task: Oberon.Task; grey: ARRAY 3 OF Display.Pattern; Cols:INTEGER;
  32.   PROCEDURE UpdateRGB(VAR col: Color);
  33.     VAR c: REAL; i: INTEGER;
  34.   BEGIN i := 0;
  35.     REPEAT c := col.hls[H] + (i + 2) / 3;
  36.       WHILE c > 1 DO c := c - 1 END;
  37.       IF c < 1/3 THEN col.rgb[i] := (1 - col.hls[S]) * col.hls[L]
  38.       ELSIF c <= 1/2 THEN col.rgb[i] := (1 - col.hls[S] + (c - 1 / 3) * 6 * col.hls[S]) * col.hls[L]
  39.       ELSIF c <= 5/6 THEN col.rgb[i] := col.hls[L]
  40.       ELSE col.rgb[i] := (1 - col.hls[S] + (1 - c) * 6 * col.hls[S]) * col.hls[L]
  41.       END;
  42.       INC(i)
  43.     UNTIL i = Comp
  44.   END UpdateRGB;
  45.   PROCEDURE UpdateHLS(VAR col: Color);
  46.     VAR max, min: REAL;
  47.     PROCEDURE Max(x, y: REAL): REAL;
  48.     BEGIN
  49.       IF x > y THEN RETURN x ELSE RETURN y END
  50.     END Max;
  51.   BEGIN max := Max(col.rgb[R], Max(col.rgb[G], col.rgb[B])); min := -Max(-col.rgb[R], Max(-col.rgb[G], -col.rgb[B]));
  52.     col.hls[H] := 0; col.hls[L] := max; col.hls[S] := 0;
  53.     IF max > 0 THEN col.hls[S] := (max - min) / max;
  54.       IF col.hls[S] > 0 THEN col.hls[H] := (max - 2 * min + col.rgb[B] - col.rgb[R] + col.rgb[G]) / (6 * (max -min));
  55.         IF (col.rgb[G] = max) OR (col.rgb[B] = min) THEN col.hls[H] := 1 - col.hls[H] END
  56.       END
  57.     END
  58.   END UpdateHLS;
  59.   PROCEDURE Int(v: REAL): INTEGER;
  60.   BEGIN RETURN SHORT(ENTIER(MaxInt * v))
  61.   END Int;
  62.   PROCEDURE UpdateDisp(VAR col: Color);
  63.   BEGIN Display.SetColor(col.nr, Int(col.rgb[0]), Int(col.rgb[1]), Int(col.rgb[2]))
  64.   END UpdateDisp;
  65.   PROCEDURE Change(VAR col: Color): BOOLEAN;
  66.     VAR d: ARRAY Comp OF INTEGER;  v: REAL; i: INTEGER; change: BOOLEAN;
  67.   BEGIN Display.GetColor(col.nr, d[0], d[1], d[2]); i := 0; change := FALSE;
  68.     WHILE i < Comp DO v := Int(col.rgb[i]);
  69.       IF v # d[i] THEN change := TRUE; col.rgb[i] := d[i] / MaxInt END;
  70.       INC(i)
  71.     END;
  72.     IF change THEN UpdateHLS(col) END;
  73.     RETURN change
  74.   END Change;
  75.   PROCEDURE ShowRGB(f: EditFrame);
  76.     VAR x, w, r, i, h: INTEGER;
  77.   BEGIN w := f.W DIV (Comp + 1) + 1; r := f.W - w * (Comp + 1); i := 0; x := 0; f.beg[i] := x; Oberon.RemoveMarks(f.X, f.Y, f.W, f.H);
  78.     WHILE i < Comp DO h := SHORT(ENTIER(f.H * f.col.rgb[i])); DEC(r);
  79.       IF r = 0 THEN DEC(w) END;
  80.       Display.ReplConst(i + 1, f.X + x, f.Y, w, h, Display.replace);
  81.       Display.ReplConst(Display.black, f.X + x, f.Y + h, w, f.H - h, Display.replace);
  82.       INC(x, w); INC(i); f.beg[i] := x
  83.     END;
  84.     Display.ReplConst(f.col.nr, f.X + x, f.Y, f.W - x, f.H, Display.replace)
  85.   END ShowRGB;
  86.   PROCEDURE ShowHLS(f: EditFrame);
  87.     VAR x, w, r, i, h: INTEGER;
  88.   BEGIN w := f.W DIV (Comp + 1); r := f.W - w * (Comp + 1); i := 0; x := 0; INC(w); f.beg[i] := x; Oberon.RemoveMarks(f.X, f.Y, f.W, f.H);
  89.     WHILE i < Comp DO h := SHORT(ENTIER(f.H * f.col.hls[i]));
  90.       IF r = 0 THEN DEC(w) END;
  91.       Display.ReplPattern(Display.white, grey[(i MOD 2) * 2], f.X + x, f.Y, w, h, Display.replace);
  92.       Display.ReplConst(Display.black, f.X + x, f.Y + h, w, f.H - h, Display.replace);
  93.       INC(x, w); INC(i); f.beg[i] := x; DEC(r)
  94.     END;
  95.     Display.ReplConst(f.col.nr, f.X + x, f.Y, f.W - x, f.H, Display.replace)
  96.   END ShowHLS;
  97.   PROCEDURE EditRGB(f: EditFrame; x, y: INTEGER; keys: SET);
  98.     VAR backUp: Color; m: Msg;  keySum: SET; last: REAL; i: INTEGER;
  99.   BEGIN keySum := keys; x := x - f.X; i := 1; backUp := f.col;
  100.     WHILE (i <= Comp) & (f.beg[i] < x) DO INC(i) END;
  101.     IF i <= Comp THEN DEC(i); last := -1;
  102.       REPEAT Input.Mouse(keys, x, y); keySum := keySum + keys;
  103.         Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, x, y); y := y - f.Y;
  104.         IF y < 0 THEN y := 0 ELSIF y > f.H THEN y := f.H END;
  105.         f.col.rgb[i] := y / f.H;
  106.         IF f.col.rgb[i] # last THEN UpdateHLS(f.col); UpdateDisp(f.col); last := f.col.rgb[i];
  107.           Oberon.RemoveMarks(f.X, f.Y, f.W, f.H);
  108.           Display.ReplConst(i + 1, f.X + f.beg[i], f.Y, f.beg[i + 1] - f.beg[i] , y, Display.replace);
  109.           Display.ReplConst(Display.black, f.X + f.beg[i], f.Y + y, f.beg[i + 1] - f.beg[i] , f.H - y, Display.replace);
  110.           Viewers.Broadcast(m)
  111.         END
  112.       UNTIL keys = {};
  113.       IF (keySum # {Left}) OR (f.col.nr > 0) & (f.col.nr < 4) THEN f.col := backUp; UpdateDisp(backUp); ShowRGB(f) END
  114.     END
  115.   END EditRGB;
  116.   PROCEDURE EditHLS(f: EditFrame; x, y: INTEGER; keys: SET);
  117.     VAR backUp: Color; m: Msg;  keySum: SET; last: REAL; i: INTEGER;
  118.   BEGIN keySum := keys; x := x - f.X; i := 1; backUp := f.col;
  119.     WHILE (i <= Comp) & (f.beg[i] < x) DO INC(i) END;
  120.     IF i <= Comp THEN DEC(i); last := -1;
  121.       REPEAT Input.Mouse(keys, x, y); keySum := keySum + keys;
  122.         Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, x, y); y := y - f.Y;
  123.         IF y < 0 THEN y := 0 ELSIF y > f.H THEN y := f.H END;
  124.         f.col.hls[i] := y / f.H;
  125.         IF f.col.hls[i] # last THEN UpdateRGB(f.col); UpdateDisp(f.col); last := f.col.hls[i];
  126.           Oberon.RemoveMarks(f.X, f.Y, f.W, f.H);
  127.           Display.ReplPattern(Display.white, grey[(i MOD 2) * 2], f.X + f.beg[i], f.Y, f.beg[i + 1] - f.beg[i] , y, Display.replace);
  128.           Display.ReplConst(Display.black, f.X + f.beg[i], f.Y + y, f.beg[i + 1] - f.beg[i] , f.H - y, Display.replace);
  129.           Viewers.Broadcast(m)
  130.         END
  131.       UNTIL keys = {};
  132.       IF (keySum # {Left}) OR (f.col.nr > 0) & (f.col.nr < 4) THEN f.col := backUp; UpdateDisp(backUp); ShowHLS(f) END
  133.     END
  134.   END EditHLS;
  135.   PROCEDURE HandleEdit(f: Display.Frame; VAR m: Display.FrameMsg);
  136.     VAR frame: EditFrame;
  137.   BEGIN
  138.     WITH f: EditFrame DO
  139.       IF m IS Oberon.InputMsg THEN
  140.         WITH m: Oberon.InputMsg DO
  141.           IF m.id = Oberon.track THEN
  142.             IF m.keys = {} THEN Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, m.X, m.Y)
  143.             ELSIF f.rgb THEN EditRGB(f, m.X, m.Y, m.keys)
  144.             ELSE EditHLS(f, m.X, m.Y, m.keys)
  145.             END
  146.           END
  147.         END
  148.       ELSIF (m IS Msg) & Change(f.col) THEN
  149.         IF f.rgb THEN ShowRGB(f) ELSE ShowHLS(f) END
  150.       ELSIF m IS Oberon.CopyMsg THEN NEW(frame); frame^ := f^; m(Oberon.CopyMsg).F := frame
  151.       ELSIF m IS MenuViewers.ModifyMsg THEN
  152.         WITH m: MenuViewers.ModifyMsg DO f.Y := m.Y; f.H := m.H;
  153.           IF f.rgb THEN ShowRGB(f) ELSE ShowHLS(f) END
  154.         END
  155.       END
  156.     END
  157.   END HandleEdit;
  158.   PROCEDURE EditColor(colNr: INTEGER; rgb: BOOLEAN);
  159.     VAR f: EditFrame;  v: Viewers.Viewer;  col: Color;  x, y: INTEGER; dummy: BOOLEAN;
  160.   BEGIN col.nr := colNr; (* col.rgb[0] := -1; col.rgb[1] := -1; col.rgb[2] := -1; *) dummy := Change(col);    (* << RC *)
  161.     NEW(f); f.col := col; f.handle := HandleEdit; f.rgb := rgb; Oberon.AllocateSystemViewer(Oberon.Mouse.X, x, y);
  162.     v := MenuViewers.New(TextFrames.NewMenu("Color", Menu), f, TextFrames.menuH, x, y);
  163.     Texts.Write(w, " "); Texts.WriteInt(w, colNr, 0); Texts.Insert(v.dsc(TextFrames.Frame).text, 5, w.buf)
  164.   END EditColor;
  165.   PROCEDURE Show(f: Frame);
  166.     VAR i, r, n, w, x: INTEGER;
  167.   BEGIN n := f.n; w := f.W DIV n; r := f.W - w * n; i := 0; x := 0; INC(w);
  168.     WHILE i < n DO f.beg[i] := x;
  169.       IF r = 0 THEN DEC(w) END;
  170.       Display.ReplConst(i, f.X + x, f.Y, w, f.H, Display.replace); INC(x, w); INC(i); DEC(r)
  171.     END
  172.   END Show;
  173.   PROCEDURE Edit(f: Frame; x, y: INTEGER; keys: SET);
  174.     VAR keySum: SET; i: INTEGER;
  175.   BEGIN keySum := keys;
  176.     REPEAT Input.Mouse(keys, x, y); keySum := keySum + keys;
  177.       Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, x, y)
  178.     UNTIL keys = {};
  179.     IF (keySum = {Left}) OR (keySum = {Right}) THEN i := 1; x := x - f.X;
  180.       WHILE (i < f.n) & (f.beg[i] < x) DO INC(i) END;
  181.       EditColor(i-1, keySum = {Left})
  182.     END
  183.   END Edit;
  184.   PROCEDURE Handler(f: Display.Frame; VAR m: Display.FrameMsg);
  185.     VAR frame: Frame;
  186.   BEGIN
  187.     WITH f: Frame DO
  188.       IF m IS Oberon.InputMsg THEN
  189.         WITH m: Oberon.InputMsg DO
  190.           IF m.id = Oberon.track THEN
  191.             IF m.keys = {} THEN Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, m.X, m.Y)
  192.             ELSE Edit(f, m.X, m.Y, m.keys)
  193.             END
  194.           END
  195.         END
  196.       ELSIF m IS Oberon.CopyMsg THEN NEW(frame); frame^ := f^; m(Oberon.CopyMsg).F := frame
  197.       ELSIF m IS MenuViewers.ModifyMsg THEN
  198.         WITH m: MenuViewers.ModifyMsg DO f.Y := m.Y; f.H := m.H; Show(f) END
  199.       END
  200.     END
  201.   END Handler;
  202.   PROCEDURE Open*;
  203.     VAR s: Texts.Scanner;  f: Frame; v: Viewers.Viewer;  x, y, n: INTEGER;
  204.   BEGIN Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s);
  205.     IF s.class = Texts.Int THEN n := SHORT(s.i) ELSE n := Cols END;
  206.     Oberon.AllocateSystemViewer(Oberon.Mouse.X, x, y); NEW(f); f.handle := Handler; f.n := n;
  207.     v := MenuViewers.New(TextFrames.NewMenu("Colors", Menu), f, TextFrames.menuH, x, y)
  208.   END Open;
  209.     PROCEDURE Scan(VAR s: Texts.Scanner);
  210.         VAR T: Texts.Text;
  211.              beg, end, time: LONGINT;
  212.     BEGIN
  213.         Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s);
  214.         IF (s.class = Texts.Char) & (s.c = "^") OR (s.line # 0) THEN
  215.             Oberon.GetSelection(T, beg, end, time);
  216.             IF time >= 0 THEN Texts.OpenScanner(s, T, beg); Texts.Scan(s) END
  217.         END
  218.     END Scan;
  219.   PROCEDURE OpenRGB*;
  220.     VAR s: Texts.Scanner;
  221.   BEGIN Scan(s);
  222.     IF s.class = Texts.Int THEN EditColor(SHORT(s.i), TRUE) END
  223.   END OpenRGB;
  224.   PROCEDURE OpenHLS*;
  225.     VAR s: Texts.Scanner;
  226.   BEGIN Scan(s);
  227.     IF s.class = Texts.Int THEN EditColor(SHORT(s.i), FALSE) END
  228.   END OpenHLS;
  229.   PROCEDURE Set*;
  230.     VAR s: Texts.Scanner;  v: ARRAY 4 OF INTEGER; i: INTEGER;
  231.   BEGIN Scan(s); i := 0;
  232.     WHILE (s.class = Texts.Int) & (i < 4) DO v[i] := SHORT(s.i); Texts.Scan(s); INC(i) END;
  233.     IF i = 4 THEN Display.SetColor(v[0], v[1], v[2], v[3]) END
  234.   END Set;
  235.   PROCEDURE Get*;
  236.     VAR s: Texts.Scanner;  v: ARRAY 4 OF INTEGER; i: INTEGER;
  237.   BEGIN Scan(s);
  238.     IF s.class = Texts.Int THEN v[0] := SHORT(s.i); Display.GetColor(v[0], v[1], v[2], v[3]); i := 0;
  239.       WHILE i < 4 DO Texts.WriteInt(w, v[i], 5); INC(i) END;
  240.       Texts.WriteLn(w); Texts.Append(Oberon.Log, w.buf)
  241.     END
  242.   END Get;
  243.     PROCEDURE Load*;
  244.       VAR par: Oberon.ParList;
  245.         S: Texts.Scanner;
  246.         f: Files.File; R: Files.Rider;
  247.         col: SHORTINT; red, green, blue: CHAR;
  248.     BEGIN
  249.       Texts.WriteString(w, "Colors.Load ");
  250.       par := Oberon.Par;
  251.       Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
  252.       IF S.class = Texts.Name THEN
  253.         Texts.WriteString(w, S.s);
  254.         f := Files.Old(S.s);
  255.         IF f # NIL THEN
  256.           Files.Set(R, f, 0); col := -1;
  257.           REPEAT
  258.             Files.Read(R, red); Files.Read(R, green); Files.Read(R, blue);
  259.             Display.SetColor(col, ORD(red), ORD(green), ORD(blue));
  260.             INC(col)
  261.           UNTIL col = 16
  262.         ELSE Texts.WriteString(w, " not found")
  263.         END
  264.       ELSE Texts.WriteString(w, " no name")
  265.       END;
  266.       Texts.WriteLn(w);
  267.       Texts.Append(Oberon.Log, w.buf)
  268.     END Load;
  269.     PROCEDURE Store*;
  270.       VAR par: Oberon.ParList;
  271.         S: Texts.Scanner;
  272.         f: Files.File; R: Files.Rider;
  273.         col, red, green, blue: INTEGER;
  274.     BEGIN
  275.       Texts.WriteString(w, "Colors.Store ");
  276.       par := Oberon.Par;
  277.       Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
  278.       IF S.class = Texts.Name THEN
  279.         Texts.WriteString(w, S.s);
  280.         f := Files.New(S.s); Files.Set(R, f, 0);
  281.         IF f # NIL THEN col := -1;
  282.           REPEAT
  283.            Display.GetColor(col, red, green, blue);
  284.            Files.Write(R, CHR(red));
  285.            Files.Write(R, CHR(green));
  286.            Files.Write(R, CHR(blue));
  287.            INC(col)
  288.           UNTIL col = 16;
  289.           Files.Register(f)
  290.         ELSE Texts.WriteString(w, " no space")
  291.         END
  292.       ELSE Texts.WriteString(w, " no name")
  293.       END;
  294.       Texts.WriteLn(w);
  295.       Texts.Append(Oberon.Log, w.buf)
  296.     END Store;
  297.   PROCEDURE* Activate;
  298.     VAR m: Msg;
  299.   BEGIN Viewers.Broadcast(m)
  300.   END Activate;
  301. BEGIN 
  302.   Cols:=SHORT(ASH(1, Amiga.OberonDepth));
  303.   Texts.OpenWriter(w);
  304.   NEW(task); task.handle := Activate; task.safe := FALSE; task.time := -1; Oberon.Install(task);
  305.   grey[0] := Display.grey0; grey[1] := Display.grey1; grey[2] := Display.grey2
  306. END Colors.
  307. Colors.Open
  308. Colors.Set ^
  309.   1 255 0 0 ~ 2 0 255 0 ~ 3 0 0 255 ~
  310. Colors.Get ^  Colors.OpenRGB ^  Colors.OpenHLS ^
  311.   0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
  312.